﻿unit UPPTitle;

interface

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Themes,

  ExtCtrls, ShellAPI;

type
  TPPTitle = class;

  TMainIco = class(TPersistent)
  private
    FPPTitle: TPPTitle;
    FPicMainIco: TPicture;
    FTop: Integer;
    FLeft: Integer;
    procedure SetPicMainIco(const Value: TPicture);
    procedure PicChange(Sender: TObject);
    procedure SetLeft(const Value: Integer);
    procedure SetTop(const Value: Integer);
  public
    constructor Create(AOwner: TPPTitle);
    destructor Destroy; override;

    function GetRect: TRect;//
  published
    property PicMainIco: TPicture read FPicMainIco write SetPicMainIco;
    property Top: Integer read FTop write SetTop default 0;
    property Left: Integer read FLeft write SetLeft default 0;
  end;

  TBackground = class(TPersistent)
  private
    FPPTitle: TPPTitle;
    FPicture: TPicture;
    procedure SetPicture(const Value: TPicture);
    procedure PicChange(Sender: TObject);
  public
    constructor Create(AOwner: TPPTitle);
    destructor Destroy; override;
  published
    property Picture: TPicture read FPicture write SetPicture;

   // property Color
  end;

  TPPTitle = class(TCustomControl)
  private
    FMainFrm: TCustomForm;
    FSideWidth: ShortInt;
    FMainIco: TMainIco;
    FBackground: TBackground;
    procedure SetSideWidth(const Value: ShortInt);
    procedure SetMainIco(const Value: TMainIco);
    procedure SetBackground(const Value: TBackground);

  protected
    // procedure WMNchist(var Msg: TMessage);message WM_NCHITTEST;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure DblClick; override;
    //
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

  published
    property Align default alTop;
    property Anchors;
    property BevelEdges;
    property BevelInner;
    property BevelKind;
    property BevelOuter;
    property BevelWidth;
    property BiDiMode;
    property BorderWidth;
    property Caption;
    property Color;  //TControl有定义
    property Constraints;
    property Ctl3D;
    property UseDockManager default True;
    property DockSite;
    property DoubleBuffered;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font; //TControl有定义
    property Padding;
    property ParentBiDiMode;
    property ParentBackground;
    property ParentColor;
    property ParentCtl3D;
    property ParentDoubleBuffered;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Touch;
    property Visible;
    //property StyleElements; //XE2中没有
    property OnAlignInsertBefore;
    property OnAlignPosition;
    property OnCanResize;
    property OnClick;
    property OnConstrainedResize;
    property OnContextPopup;
    property OnDockDrop;
    property OnDockOver;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnGesture;
    property OnGetSiteInfo;
    property OnMouseActivate;
    property OnMouseDown;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property OnStartDock;
    property OnStartDrag;
    property OnUnDock;

    property SideWidth: ShortInt read FSideWidth write SetSideWidth;
    property MainIco: TMainIco read FMainIco write SetMainIco;
    property Background: TBackground read FBackground write SetBackground;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('PPVCL', [TPPTitle]);
end;

{ TPPTitle }

constructor TPPTitle.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
    csSetCaption, csOpaque, csDoubleClicks, csReplicatable, csPannable, csGestures];
  { When themes are on in an application default to making
    TCustomPanel's paint with their ParentBackground }
  if StyleServices.Enabled then
    ControlStyle := ControlStyle + [csParentBackground] - [csOpaque];
//
  BevelOuter := bvNone;
  Align := alTop;
  Color := clHighlight;
  Height := 80;
  if AOwner is TCustomForm then
  begin
    FMainFrm := TCustomForm(AOwner);
  end;
  FMainIco := TMainIco.Create(Self);
  FBackground := TBackground.Create(Self);
end;

procedure TPPTitle.DblClick;
var
  abd: TAppBarData; // Winapi.ShellAPI
begin
  if Assigned(FMainFrm) then
  begin
    { if FMainFrm.WindowState = wsNormal then
      FMainFrm.WindowState := wsMaximized
      else
      FMainFrm.WindowState := wsNormal; }
    if FMainFrm.WindowState = wsNormal then
    begin
      FMainFrm.WindowState := wsMaximized; // BorderStyleÎ为 bsNone
      abd.cbSize := sizeof(abd);
      SHAppBarMessage(ABM_GETTASKBARPOS, abd); // 读取任务栏的区域
      FMainFrm.Height := FMainFrm.Height - (abd.rc.Bottom - abd.rc.Top);
      // 预留出任务栏的位置
      // Screen.WorkAreaHeight
    end
    else if FMainFrm.WindowState = wsMaximized then
    begin
      FMainFrm.WindowState := wsNormal;
    end;
  end;
  inherited;
end;

destructor TPPTitle.Destroy;
begin
  FMainIco.Free;
  FBackground.Free;
  inherited Destroy;
end;

procedure TPPTitle.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited;
  if Assigned(FMainFrm) then
  begin
    ReleaseCapture;
    SendMessage(FMainFrm.Handle, WM_SYSCOMMAND, $F012, 0);
  end;
end;

procedure TPPTitle.Paint;
var
  S: String;
  R: TRect;
begin
  inherited;
  //Canvas := Self.Canvas;
  R := GetClientRect;
  with Canvas do
  begin
    //画背景
    if not Assigned(FBackground.Picture.Graphic) then
    begin
      Brush.Color := Color;
      FillRect(R);
    end
    else
      StretchDraw(ClientRect, FBackground.Picture.Graphic);
    //ICon
    if not Assigned(FMainIco.FPicMainIco.Graphic) then
      FMainIco.FPicMainIco.Icon.Assign(Application.Icon);
    Draw(FMainIco.Left, FMainIco.Top, FMainIco.FPicMainIco.Graphic);
    //Caption
    S := Caption;
    if S <> '' then
    begin
      Font.Assign(Self.Font);
      R := FMainIco.GetRect;
      Brush.Style := bsClear;
      TextRect(R, S, [tfEndEllipsis, tfNoClip]);
    end;
  end;
  {
  with Canvas do
  begin
    Pen.Width := 1;
    Pen.Color := clBtnShadow;
  end;  }
end;

procedure TPPTitle.SetBackground(const Value: TBackground);
begin
  if FBackground = Value then Exit;
  FBackground.Assign(Value);
  Invalidate;
end;

procedure TPPTitle.SetMainIco(const Value: TMainIco);
begin
  if FMainIco = Value then Exit;
  FMainIco.Assign(Value);
  Invalidate;
end;

procedure TPPTitle.SetSideWidth(const Value: ShortInt);
begin
  if FSideWidth = Value then
    Exit;

  FSideWidth := Value;
  if Assigned(FMainFrm) then
  begin
    FMainFrm.Padding.Left := Value;
    FMainFrm.Padding.Bottom := Value;
    FMainFrm.Padding.Right := Value;
  end;
end;

{ TMainIco }

constructor TMainIco.Create(AOwner: TPPTitle);
begin
  inherited Create;
  if AOwner = nil then raise Exception.Create('创建主窗体图标失败! ');
  FPPTitle := AOwner;
  FPicMainIco := TPicture.Create;
  FPicMainIco.OnChange := PicChange;
  FTop := 0; FLeft := 0;
end;

destructor TMainIco.Destroy;
begin
  FPicMainIco.Free;
  inherited;
end;

function TMainIco.GetRect: TRect;
begin
  Result.Top := FTop + 8;
  Result.Left := FPicMainIco.Graphic.Width + FLeft;//
  Result.Right := FPPTitle.Width;//要计算所有按钮的宽度
  Result.Bottom := FPicMainIco.Graphic.Height;//这里要定义一个高度
end;

procedure TMainIco.PicChange(Sender: TObject);
begin
  FPPTitle.Invalidate;
end;

procedure TMainIco.SetLeft(const Value: Integer);
begin
  if FLeft = Value then Exit;

  FLeft := Value;
  FPPTitle.Invalidate;
end;

procedure TMainIco.SetPicMainIco(const Value: TPicture);
begin
  FPicMainIco.Assign(Value);
end;

procedure TMainIco.SetTop(const Value: Integer);
begin
  if FTop = Value then Exit;

  FTop := Value;
  FPPTitle.Invalidate;
end;

{ TBackground }

constructor TBackground.Create(AOwner: TPPTitle);
begin
  inherited Create;
  if AOwner = nil then raise Exception.Create('创建主窗体图标失败! ');
  FPPTitle := AOwner;
  FPicture := TPicture.Create;
  FPicture.OnChange := PicChange;
end;

destructor TBackground.Destroy;
begin
  FPicture.Free;
  inherited;
end;

procedure TBackground.PicChange(Sender: TObject);
begin
  FPPTitle.Invalidate;
end;

procedure TBackground.SetPicture(const Value: TPicture);
begin
  FPicture.Assign(Value);
end;

end.
